home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / C / Applications / UIFlow 1.0.1 / UIFlow Source / VSet2.0 / Src / eg2.f < prev    next >
Encoding:
Text File  |  1992-04-20  |  3.0 KB  |  115 lines  |  [TEXT/????]
  1. c  ==================================================================    
  2. c
  3. c    EG1.F
  4. c    HDF VSET Sample Program
  5. c
  6. c    Multiple files access
  7. c    creates 2 vsets in 2 files simultaneously
  8. c
  9. c    compile and link
  10. c    compile to get the object file 'eg1.o'
  11. c    link 'eg1.o' with the libraries 'libvg.a' and 'libdf.a'
  12. c
  13. c    ==================================================================
  14. c     
  15. c                  NCSA HDF Vset release 2.0
  16. c                    December, 1990
  17. c                Jason NG NCSA 15-DEC-90
  18. c    
  19. c     NCSA HDF Vset release 2.0 source code and documentation are in the public
  20. c     domain.  Specifically, we give to the public domain all rights for future
  21. c     licensing of the source code, all resale rights, and all publishing rights.
  22. c     
  23. c     We ask, but do not require, that the following message be included in all
  24. c     derived works:
  25. c     
  26. c     Portions developed at the National Center for Supercomputing Applications at
  27. c     the University of Illinois at Urbana-Champaign.
  28. c     
  29. c     THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
  30. c     SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
  31. c     WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
  32. c     
  33. c    ==================================================================
  34.  
  35.     program SAMPLE
  36.  
  37.     integer    buf(100), sbuf(100), i,n
  38.     integer f1,f2
  39.  
  40.     external DFOPEN, DFCLOSE
  41.     external VSFATCH, VSFDTCH, VSFSFLD, VSFSNAM, VSFWRIT 
  42.     external VSFFDEF
  43.     external VFATCH, VFDTCH, VFSNAM, VFINSRT 
  44.     integer    DFOPEN
  45.     integer  VSFATCH, VSFSFLD, VSFWRIT, VSFFDEF
  46.     integer  VFATCH, VFINSRT
  47.  
  48.     integer  vs1, vg1
  49.     integer  vs2, vg2
  50.  
  51. c    some defined constants. see "vg.h"
  52.  
  53.     integer INTTYPE                
  54.     parameter (INTTYPE=2)
  55.     integer    FINTRLACE
  56.     parameter (FINTRLACE=0)
  57.  
  58.     integer FULLACC    
  59.     parameter (FULLACC=7)
  60.  
  61. c    ------ generate data -------
  62.     do 111 i=1,100
  63.         buf(i) = i+500
  64.         sbuf(i) = i+7000
  65. 111    continue
  66.  
  67.  
  68. c    ================================================
  69. c    ====== begin creating 2 vsets in 2 files =======
  70. c    ================================================
  71.  
  72. c    --- open 2 files, with file pointers f1 and f2
  73.  
  74.     f1 = DFOPEN ('for1.hdf', FULLACC, 0)
  75.     f2 = DFOPEN ('for2.hdf', FULLACC, 0)
  76.  
  77. c    --- attach a new vgroup in each file, give each a name
  78.  
  79.     vg1 = VFATCH (f1, -1,'w')
  80.     vg2 = VFATCH (f2, -1,'w')
  81.     call VFSNAM(vg1, 'my_fortran_group_one')
  82.     call VFSNAM(vg2, 'my_fortran_group_two')
  83.  
  84. c    --- attach a new vdata to file f1, write 70 integers,
  85. c    --- link the vdata to vg1, then detach it
  86.  
  87.     vs1 = VSFATCH (f1, -1,'w')
  88.     call VSFSNAM(vs1, 'dataset-of-70-integers')
  89.     n = VSFSFLD (vs1, 'IY')
  90.     n = VSFWRIT (vs1, buf, 70, FINTRLACE)
  91.     n = VFINSRT (vg1, vs1)
  92.     call VSFDTCH (vs1)
  93.  
  94. c    --- attach a new vdata to file f2, write 30 integers,
  95. c    --- link the vdata to vg2, then detach it
  96.     vs2 = VSFATCH (f2, -1,'w')
  97.     n = VSFSFLD (vs2, 'IY')
  98.     n = VSFWRIT (vs2, buf, 30, FINTRLACE)
  99.     call VSFSNAM(vs2, 'dataset-of-thirty-integers')
  100.     n = VFINSRT (vg2, vs2)
  101.     call VSFDTCH (vs2)
  102.  
  103. c    --- detach each vgroup in each file
  104.     call VFDTCH (vg1)
  105.     call VFDTCH (vg2)
  106.  
  107. c    --- close each file
  108.     call DFCLOSE (f1)
  109.     call DFCLOSE (f2)
  110.  
  111.     print *,'done creating vsets in 2 files '
  112.  
  113.     end
  114.  
  115.